home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / CLOCKIN / CLOCK.PAS next >
Pascal/Delphi Source File  |  1992-12-20  |  4KB  |  123 lines
  1. program graphclock;
  2. uses
  3.      graph,graphing,dos,crt;
  4.  
  5.  
  6. function printmonth(month:word):string;
  7. begin
  8.      case month of
  9.           1: printmonth:='january';
  10.           2: printmonth:='february';
  11.           3: printmonth:='march';
  12.           4: printmonth:='april';
  13.           5: printmonth:='may';
  14.           6: printmonth:='june';
  15.           7: printmonth:='july';
  16.           8: printmonth:='august';
  17.           9: printmonth:='september';
  18.           10: printmonth:='october';
  19.           11: printmonth:='november';
  20.           12: printmonth:='december'
  21.           else exit;
  22.      end;
  23. end;
  24.  
  25.  
  26. function printdayofweek(day:word):string;
  27. begin
  28.      case day of
  29.           0: printdayofweek:='sunday';
  30.           1: printdayofweek:='monday';
  31.           2: printdayofweek:='tuesday';
  32.           3: printdayofweek:='wednesday';
  33.           4: printdayofweek:='thursday';
  34.           5: printdayofweek:='friday';
  35.           6: printdayofweek:='saturday'
  36.           else exit;
  37.      end;
  38. end;
  39.  
  40. procedure putoutclocktimer;
  41. const
  42.      lasthour:word=hrhandsize;
  43.      lastminute:word=minhandsize;
  44.      lastsecond:word=sechandsize;
  45.      lasthundrethofasecond:word=hndthsechandsize;
  46. var
  47.      hour,minute,second,hundrethofasecond:word;
  48.      txh,txw:integer;
  49. begin
  50.      txh:=textheight('d');
  51.      txw:=textwidth('d');
  52.      setcolor(white);
  53.      outtextxy(1,1,'  :  :  .  ');
  54.      repeat
  55.           gettime(hour,minute,second,hundrethofasecond);
  56.           if not(lasthour=hour) then begin
  57.                puthand(lasthour,hour,hr);
  58.                setcolor(white);
  59.                bar(0,0,2*txw,txh);
  60.                outtextxy(1,1,streng(hour));
  61.                lasthour:=hour;
  62.           end;
  63.           if not(lastminute=minute) then begin
  64.                puthand(lastminute,minute,min);
  65.                setcolor(white);
  66.                bar(3*txw,0,5*txw,txh);
  67.                outtextxy(3*txw,1,streng(minute));
  68.                lastminute:=minute;
  69.           end;
  70.           if not(lastsecond=second) then begin
  71.                puthand(lastsecond,second,sec);
  72.                setcolor(white);
  73.                bar(6*txw,0,8*txw,txh);
  74.                beep;
  75.                outtextxy(6*txw,1,streng(second));
  76.                lastsecond:=second;
  77.           end;
  78.           if not(lasthundrethofasecond=hundrethofasecond) then begin
  79.                puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
  80.                setcolor(white);
  81.                bar(9*txw,0,11*txw,txh);
  82.                outtextxy(9*txw,1,streng(hundrethofasecond));
  83.                lasthundrethofasecond:=hundrethofasecond;
  84.           end;
  85.      until keypressed;
  86. end;
  87.  
  88. procedure putoutclock;
  89. const
  90.      lasthour:word=hrhandsize;
  91.      lastminute:word=minhandsize;
  92.      lastsecond:word=sechandsize;
  93.      lasthundrethofasecond:word=hndthsechandsize;
  94. var
  95.      hour,minute,second,hundrethofasecond:word;
  96. begin
  97.      repeat
  98.           gettime(hour,minute,second,hundrethofasecond);
  99.           if not(lasthour=hour) then begin
  100.                puthand(lasthour,hour,hr);
  101.                lasthour:=hour;
  102.           end;
  103.           if not(lastminute=minute) then begin
  104.                puthand(lastminute,minute,min);
  105.                lastminute:=minute;
  106.           end;
  107.           if not(lastsecond=second) then begin
  108.                puthand(lastsecond,second,sec);
  109.                beep;
  110.                lastsecond:=second;
  111.           end;
  112.           if not(lasthundrethofasecond=hundrethofasecond) then begin
  113.                puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
  114.                lasthundrethofasecond:=hundrethofasecond;
  115.           end;
  116.      until keypressed;
  117. end;
  118. begin
  119.      setupgraph;
  120.      setupgrid;
  121.      putoutclock;
  122.      closegraph;
  123. end.